home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH2 / SRC / GETBITS.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-01-08  |  14.2 KB  |  489 lines
  1. VERSION 4.00
  2. Begin VB.Form BitmapForm 
  3.    Caption         =   "GetBitmapBits"
  4.    ClientHeight    =   2100
  5.    ClientLeft      =   2280
  6.    ClientTop       =   1815
  7.    ClientWidth     =   3180
  8.    Height          =   2790
  9.    Left            =   2220
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2100
  12.    ScaleWidth      =   3180
  13.    Top             =   1185
  14.    Width           =   3300
  15.    Begin VB.PictureBox Pict3 
  16.       AutoRedraw      =   -1  'True
  17.       AutoSize        =   -1  'True
  18.       Height          =   1020
  19.       Left            =   2160
  20.       Picture         =   "GETBITS.frx":0000
  21.       ScaleHeight     =   64
  22.       ScaleMode       =   3  'Pixel
  23.       ScaleWidth      =   64
  24.       TabIndex        =   8
  25.       Top             =   240
  26.       Width           =   1020
  27.    End
  28.    Begin VB.PictureBox Pict2 
  29.       AutoRedraw      =   -1  'True
  30.       AutoSize        =   -1  'True
  31.       Height          =   1020
  32.       Left            =   1080
  33.       Picture         =   "GETBITS.frx":1092
  34.       ScaleHeight     =   64
  35.       ScaleMode       =   3  'Pixel
  36.       ScaleWidth      =   64
  37.       TabIndex        =   7
  38.       Top             =   240
  39.       Width           =   1020
  40.    End
  41.    Begin VB.PictureBox Pict1 
  42.       AutoRedraw      =   -1  'True
  43.       AutoSize        =   -1  'True
  44.       Height          =   1020
  45.       Left            =   0
  46.       Picture         =   "GETBITS.frx":2124
  47.       ScaleHeight     =   64
  48.       ScaleMode       =   3  'Pixel
  49.       ScaleWidth      =   64
  50.       TabIndex        =   6
  51.       Top             =   240
  52.       Width           =   1020
  53.    End
  54.    Begin VB.CommandButton CmdColors 
  55.       Caption         =   "Colors"
  56.       Height          =   375
  57.       Left            =   2355
  58.       TabIndex        =   5
  59.       Top             =   1680
  60.       Width           =   615
  61.    End
  62.    Begin VB.CommandButton CmdCheck 
  63.       Caption         =   "Check"
  64.       Height          =   375
  65.       Left            =   1635
  66.       TabIndex        =   4
  67.       Top             =   1680
  68.       Width           =   615
  69.    End
  70.    Begin VB.CommandButton CmdWave 
  71.       Caption         =   "Wave"
  72.       Height          =   375
  73.       Left            =   915
  74.       TabIndex        =   3
  75.       Top             =   1680
  76.       Width           =   615
  77.    End
  78.    Begin VB.CommandButton CmdBlank 
  79.       Caption         =   "Blank"
  80.       Height          =   375
  81.       Left            =   195
  82.       TabIndex        =   1
  83.       Top             =   1680
  84.       Width           =   615
  85.    End
  86.    Begin VB.PictureBox Original 
  87.       AutoRedraw      =   -1  'True
  88.       AutoSize        =   -1  'True
  89.       Height          =   1020
  90.       Left            =   3000
  91.       Picture         =   "GETBITS.frx":31B6
  92.       ScaleHeight     =   64
  93.       ScaleMode       =   3  'Pixel
  94.       ScaleWidth      =   64
  95.       TabIndex        =   0
  96.       Top             =   1680
  97.       Visible         =   0   'False
  98.       Width           =   1020
  99.    End
  100.    Begin VB.Label Label1 
  101.       Alignment       =   2  'Center
  102.       Caption         =   "Line"
  103.       Height          =   255
  104.       Index           =   2
  105.       Left            =   2160
  106.       TabIndex        =   13
  107.       Top             =   0
  108.       Width           =   975
  109.    End
  110.    Begin VB.Label Label1 
  111.       Alignment       =   2  'Center
  112.       Caption         =   "GetBitmapBits"
  113.       Height          =   255
  114.       Index           =   1
  115.       Left            =   1080
  116.       TabIndex        =   12
  117.       Top             =   0
  118.       Width           =   975
  119.    End
  120.    Begin VB.Label Label1 
  121.       Alignment       =   2  'Center
  122.       Caption         =   "Line/Refresh"
  123.       Height          =   255
  124.       Index           =   0
  125.       Left            =   0
  126.       TabIndex        =   11
  127.       Top             =   0
  128.       Width           =   975
  129.    End
  130.    Begin VB.Label Time2 
  131.       BorderStyle     =   1  'Fixed Single
  132.       Height          =   255
  133.       Left            =   1080
  134.       TabIndex        =   10
  135.       Top             =   1320
  136.       Width           =   1020
  137.    End
  138.    Begin VB.Label Time1 
  139.       BorderStyle     =   1  'Fixed Single
  140.       Height          =   255
  141.       Left            =   0
  142.       TabIndex        =   9
  143.       Top             =   1320
  144.       Width           =   1020
  145.    End
  146.    Begin VB.Label Time3 
  147.       BorderStyle     =   1  'Fixed Single
  148.       Height          =   255
  149.       Left            =   2160
  150.       TabIndex        =   2
  151.       Top             =   1320
  152.       Width           =   1020
  153.    End
  154.    Begin VB.Menu mnuFile 
  155.       Caption         =   "&File"
  156.       Begin VB.Menu mnuFileExit 
  157.          Caption         =   "E&xit"
  158.       End
  159.    End
  160. Attribute VB_Name = "BitmapForm"
  161. Attribute VB_Creatable = False
  162. Attribute VB_Exposed = False
  163. Option Explicit
  164. Private Sub CmdWave_Click()
  165. Const AMP = 3
  166. Const PER = 5
  167. Dim start_time As Single
  168. Dim stop_time As Single
  169. Dim hbm As Integer
  170. Dim bm As BITMAP
  171. Dim status As Integer
  172. Dim bytes() As Byte
  173. Dim i As Integer
  174. Dim j As Integer
  175. Dim k As Integer
  176. Dim wid As Integer
  177. Dim hgt As Integer
  178.     CmdBlank.Enabled = False
  179.     CmdWave.Enabled = False
  180.     CmdCheck.Enabled = False
  181.     CmdColors.Enabled = False
  182.     Time1.Caption = ""
  183.     Time2.Caption = ""
  184.     Time3.Caption = ""
  185.     Pict1.Picture = Original.Image
  186.     Pict2.Picture = Original.Image
  187.     Pict3.Picture = Original.Image
  188.     MousePointer = vbHourglass
  189.     Refresh
  190.     ' ***************************************
  191.     ' Wave picture 1 using PSet with refresh.
  192.     ' ***************************************
  193.     start_time = Timer()
  194.     For i = AMP To Pict1.ScaleHeight - AMP Step 3
  195.         For j = 0 To Pict1.ScaleWidth - 1
  196.             k = AMP * Cos(j / PER)
  197.             Pict1.PSet (j, i + k), vbBlack
  198.         Next j
  199.         Pict1.Refresh
  200.     Next i
  201.     stop_time = Timer()
  202.     Time1.Caption = Format$(stop_time - start_time, "0.00000")
  203.     Time1.Refresh
  204.     ' *****************************
  205.     ' Wave picture 2 using SetBits.
  206.     ' *****************************
  207.     start_time = Timer()
  208.     hbm = Pict2.Image
  209.     ' See how big it is.
  210.     status = GetObject(hbm, BITMAP_SIZE, bm)
  211.     ' Get the bits.
  212.     wid = bm.bmWidthBytes
  213.     hgt = bm.bmHeight
  214.     ReDim bytes(1 To wid, 1 To hgt)
  215.     status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  216.     ' Make the wave.
  217.     For i = AMP + 1 To hgt - AMP Step 3
  218.         For j = 1 To wid
  219.             k = AMP * Cos(j / PER)
  220.             bytes(j, i + k) = 0
  221.         Next j
  222.     Next i
  223.     ' Set the bits.
  224.     status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  225.     Pict2.Refresh
  226.     stop_time = Timer()
  227.     Time2.Caption = Format$(stop_time - start_time, "0.00000")
  228.     Time2.Refresh
  229.     ' ******************************************
  230.     ' Wave picture 3 using PSet without refresh.
  231.     ' ******************************************
  232.     start_time = Timer()
  233.     For i = AMP To Pict3.ScaleHeight - AMP Step 3
  234.         For j = 0 To Pict3.ScaleWidth - 1
  235.             k = AMP * Cos(j / PER)
  236.             Pict3.PSet (j, i + k), vbBlack
  237.         Next j
  238.     Next i
  239.     Pict3.Refresh
  240.     stop_time = Timer()
  241.     Time3.Caption = Format$(stop_time - start_time, "0.00000")
  242.     CmdBlank.Enabled = True
  243.     CmdWave.Enabled = True
  244.     CmdCheck.Enabled = True
  245.     CmdColors.Enabled = True
  246.     MousePointer = vbDefault
  247. End Sub
  248. Private Sub CmdCheck_Click()
  249. Dim start_time As Single
  250. Dim stop_time As Single
  251. Dim hbm As Integer
  252. Dim bm As BITMAP
  253. Dim status As Integer
  254. Dim bytes() As Byte
  255. Dim i As Integer
  256. Dim j As Integer
  257. Dim wid As Integer
  258. Dim hgt As Integer
  259.     CmdBlank.Enabled = False
  260.     CmdWave.Enabled = False
  261.     CmdCheck.Enabled = False
  262.     CmdColors.Enabled = False
  263.     Time1.Caption = ""
  264.     Time2.Caption = ""
  265.     Time3.Caption = ""
  266.     Pict1.Picture = Original.Image
  267.     Pict2.Picture = Original.Image
  268.     Pict3.Picture = Original.Image
  269.     MousePointer = vbHourglass
  270.     Refresh
  271.     ' ****************************************
  272.     ' Check picture 1 using PSet with refresh.
  273.     ' ****************************************
  274.     start_time = Timer()
  275.     wid = Pict1.ScaleWidth - 1
  276.     hgt = Pict1.ScaleHeight - 1
  277.     For i = 0 To hgt Step 2
  278.         Pict1.Line (0, i)-(wid, i)
  279.         Pict1.Refresh
  280.     Next i
  281.     For i = 0 To wid Step 2
  282.         Pict1.Line (i, 0)-(i, hgt)
  283.         Pict1.Refresh
  284.     Next i
  285.     stop_time = Timer()
  286.     Time1.Caption = Format$(stop_time - start_time, "0.00000")
  287.     Time1.Refresh
  288.     ' ******************************
  289.     ' Check picture 2 using SetBits.
  290.     ' ******************************
  291.     start_time = Timer()
  292.     hbm = Pict2.Image
  293.     ' See how big it is.
  294.     status = GetObject(hbm, BITMAP_SIZE, bm)
  295.     ' Get the bits.
  296.     wid = bm.bmWidthBytes
  297.     hgt = bm.bmHeight
  298.     ReDim bytes(1 To wid, 1 To hgt)
  299.     status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  300.     ' Check it.
  301.     For i = 1 To hgt Step 2
  302.         For j = 1 To wid
  303.             bytes(j, i) = 0
  304.         Next j
  305.     Next i
  306.     For i = 1 To wid Step 2
  307.         For j = 1 To hgt
  308.             bytes(i, j) = 0
  309.         Next j
  310.     Next i
  311.     ' Set the bits.
  312.     status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  313.     Pict2.Refresh
  314.     stop_time = Timer()
  315.     Time2.Caption = Format$(stop_time - start_time, "0.00000")
  316.     Time2.Refresh
  317.     ' ******************************************
  318.     ' Wave picture 3 using PSet without refresh.
  319.     ' ******************************************
  320.     start_time = Timer()
  321.     wid = Pict3.ScaleWidth - 1
  322.     hgt = Pict3.ScaleHeight - 1
  323.     For i = 0 To hgt Step 2
  324.         Pict3.Line (0, i)-(wid, i)
  325.     Next i
  326.     For i = 0 To wid Step 2
  327.         Pict3.Line (i, 0)-(i, hgt)
  328.     Next i
  329.     Pict3.Refresh
  330.     stop_time = Timer()
  331.     Time3.Caption = Format$(stop_time - start_time, "0.00000")
  332.     CmdBlank.Enabled = True
  333.     CmdWave.Enabled = True
  334.     CmdCheck.Enabled = True
  335.     CmdColors.Enabled = True
  336.     MousePointer = vbDefault
  337. End Sub
  338. Sub CmdColors_Click()
  339. Static running As Boolean
  340. Dim hbm As Integer
  341. Dim bm As BITMAP
  342. Dim status As Integer
  343. Dim bytes() As Byte
  344. Dim i As Integer
  345. Dim j As Integer
  346. Dim wid As Integer
  347. Dim hgt As Integer
  348. Dim color As Integer
  349.     If running Then
  350.         running = False
  351.         CmdColors.Enabled = False
  352.         Exit Sub
  353.     End If
  354.     CmdBlank.Enabled = False
  355.     CmdWave.Enabled = False
  356.     CmdCheck.Enabled = False
  357.     CmdColors.Caption = "Stop"
  358.     running = True
  359.     Time1.Caption = ""
  360.     Time2.Caption = ""
  361.     Time3.Caption = ""
  362.     Pict1.Picture = Original.Image
  363.     Pict2.Picture = Original.Image
  364.     Pict3.Picture = Original.Image
  365.     MousePointer = vbHourglass
  366.     Refresh
  367.         
  368.     ' Get the bits.
  369.     hbm = Pict2.Image
  370.     status = GetObject(hbm, BITMAP_SIZE, bm)
  371.     wid = bm.bmWidthBytes
  372.     hgt = bm.bmHeight
  373.     ReDim bytes(1 To wid, 1 To hgt)
  374.     status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  375.     wid = bm.bmWidthBytes
  376.     ' Display the colors in the palette.
  377.     For color = 0 To 255
  378.         If Not running Then Exit For
  379.         Time2.Caption = Format$(color)
  380.         For i = 1 To wid
  381.             For j = 1 To hgt
  382.                 If bytes(i, j) <> 255 Then _
  383.                    bytes(i, j) = color
  384.             Next j
  385.         Next i
  386.         status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  387.         Pict2.Refresh
  388.         
  389.         ' Waste a little time. You may need to
  390.         ' adjust this for your computer.
  391.         For i = 1 To 1000
  392.             DoEvents
  393.         Next i
  394.     Next color
  395.     running = False
  396.     Time2.Caption = ""
  397.     Pict2.Picture = Original.Image
  398.     CmdColors.Caption = "Colors"
  399.     CmdBlank.Enabled = True
  400.     CmdWave.Enabled = True
  401.     CmdCheck.Enabled = True
  402.     CmdColors.Enabled = True
  403.     MousePointer = vbDefault
  404. End Sub
  405. Private Sub CmdBlank_Click()
  406. Dim start_time As Single
  407. Dim stop_time As Single
  408. Dim hbm As Integer
  409. Dim bm As BITMAP
  410. Dim status As Integer
  411. Dim bytes() As Byte
  412. Dim i As Integer
  413. Dim j As Integer
  414. Dim wid As Integer
  415. Dim hgt As Integer
  416.     CmdBlank.Enabled = False
  417.     CmdWave.Enabled = False
  418.     CmdCheck.Enabled = False
  419.     CmdColors.Enabled = False
  420.     Time1.Caption = ""
  421.     Time2.Caption = ""
  422.     Time3.Caption = ""
  423.     Pict1.Picture = Original.Image
  424.     Pict2.Picture = Original.Image
  425.     Pict3.Picture = Original.Image
  426.     MousePointer = vbHourglass
  427.     Refresh
  428.     ' ****************************************
  429.     ' Blank picture 1 using PSet with refresh.
  430.     ' ****************************************
  431.     start_time = Timer()
  432.     For i = 0 To Pict1.ScaleHeight - 1
  433.         For j = 0 To Pict1.ScaleWidth - 1
  434.             Pict1.PSet (j, i), vbBlack
  435.         Next j
  436.         Pict1.Refresh
  437.     Next i
  438.     stop_time = Timer()
  439.     Time1.Caption = Format$(stop_time - start_time, "0.00000")
  440.     Time1.Refresh
  441.     ' ******************************
  442.     ' Blank picture 2 using SetBits.
  443.     ' ******************************
  444.     start_time = Timer()
  445.     hbm = Pict2.Image
  446.     ' See how big it is.
  447.     status = GetObject(hbm, BITMAP_SIZE, bm)
  448.     ' Get the bits.
  449.     wid = bm.bmWidthBytes
  450.     hgt = bm.bmHeight
  451.     ReDim bytes(1 To wid, 1 To hgt)
  452.     status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  453.     ' Set all bits to color 0.
  454.     For i = 1 To hgt
  455.         For j = 1 To wid
  456.             bytes(i, j) = 0
  457.         Next j
  458.     Next i
  459.     ' Set the bits.
  460.     status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  461.     Pict2.Refresh
  462.     stop_time = Timer()
  463.     Time2.Caption = Format$(stop_time - start_time, "0.00000")
  464.     Time2.Refresh
  465.     ' *******************************************
  466.     ' Blank picture 3 using PSet without refresh.
  467.     ' *******************************************
  468.     start_time = Timer()
  469.     For i = 0 To Pict3.ScaleWidth - 1
  470.         For j = 0 To Pict3.ScaleHeight - 1
  471.             Pict3.PSet (i, j), vbBlack
  472.         Next j
  473.     Next i
  474.     Pict3.Refresh
  475.     stop_time = Timer()
  476.     Time3.Caption = Format$(stop_time - start_time, "0.00000")
  477.     CmdBlank.Enabled = True
  478.     CmdWave.Enabled = True
  479.     CmdCheck.Enabled = True
  480.     CmdColors.Enabled = True
  481.     MousePointer = vbDefault
  482. End Sub
  483. Private Sub Form_Unload(Cancel As Integer)
  484.     End
  485. End Sub
  486. Private Sub mnuFileExit_Click()
  487.     Unload Me
  488. End Sub
  489.